home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / forth / amiga / amigaker.arc / 15.structs < prev    next >
Encoding:
Text File  |  1987-12-30  |  8.0 KB  |  251 lines
  1. ;
  2. ;  15.structures.
  3. ;
  4. ;
  5.  
  6.  
  7. * ?condition      (s f -- ) Compile time checking.
  8.                   dc.w     -1
  9.                   dc.l     link3
  10. link3             set      *-4
  11.                   dc.b     $8A,'?conditio',$80!'n'
  12.                   cnop     0,2
  13. _question_condition
  14.                   dc.l     nest
  15.                   dc.l     _not,_nest_abort_quote
  16.                   dc.b     19,'Conditionals Wrong',0
  17.                   cnop     0,2
  18.                   dc.l     _exit
  19.  
  20. * >mark           (s -- addr ) Set up for forward branch.
  21.                   dc.w     -1
  22.                   dc.l     link2
  23. link2             set      *-4
  24.                   dc.b     $85,'>mar',$80!'k'
  25.                   cnop     0,2
  26. _to_mark          dc.l     nest
  27.                   dc.l     _here,_0,_comma,_exit
  28.  
  29. * >resolve        (s addr -- ) Resolve a forward branch.
  30.                   dc.w     -1
  31.                   dc.l     link2
  32. link2             set      *-4
  33.                   dc.b     $88,'>resolv',$80!'e'
  34.                   cnop     0,2
  35. _to_resolve       dc.l     nest
  36.                   dc.l     _here,_swap,_store,_exit
  37.  
  38. * <mark           (s -- addr ) Set up for a Backward branch.
  39.                   dc.w     -1
  40.                   dc.l     link0
  41. link0             set      *-4
  42.                   dc.b     $85,'<mar',$80!'k'
  43.                   cnop     0,2
  44. _from_mark        dc.l     nest
  45.                   dc.l     _here,_exit
  46.  
  47. * <resolve        (s addr -- ) Resolve a Backward branch.
  48.                   dc.w     -1
  49.                   dc.l     link0
  50. link0             set      *-4
  51.                   dc.b     $88,'<resolv',$80!'e'
  52.                   cnop     0,2
  53. _from_resolve     dc.l     nest
  54.                   dc.l     _comma,_exit
  55.  
  56. ;following routines are the same as the above, but use error checking.
  57.  
  58. * ?>mark          (s -- f addr ) 
  59.                   dc.w     -1
  60.                   dc.l     link3
  61. link3             set      *-4
  62.                   dc.b     $86,'?>mar',$80!'k'
  63.                   cnop     0,2
  64. _question_to_mark dc.l     nest
  65.                   dc.l     _true,_to_mark,_exit
  66.  
  67. * ?>resolve       (s f addr -- )
  68.                   dc.w     -1
  69.                   dc.l     link3
  70. link3             set      *-4
  71.                   dc.b     $89,'?>resolv',$80!'e'
  72.                   cnop     0,2
  73. _question_to_resolve
  74.                   dc.l     nest
  75.                   dc.l     _swap,_question_condition,_to_resolve
  76.                   dc.l     _exit
  77.  
  78. * ?<mark          (s -- f addr )
  79.                   dc.w     -1
  80.                   dc.l     link3
  81. link3             set      *-4
  82.                   dc.b     $86,'?<mar',$80!'k'
  83.                   cnop     0,2
  84. _question_from_mark
  85.                   dc.l     nest
  86.                   dc.l     _true,_from_mark,_exit
  87.  
  88. * ?<resolve       (s f addr -- )
  89.                   dc.w     -1
  90.                   dc.l     link3
  91. link3             set      *-4
  92.                   dc.b     $89,'?<resolv',$80!'e'
  93.                   cnop     0,2
  94. _question_from_resolve
  95.                   dc.l     nest
  96.                   dc.l     _swap,_question_condition
  97.                   dc.l     _from_resolve,_exit
  98.  
  99. * leave           (s -- ) Compiles the runtime routine (leave).
  100.                   dc.w     -1
  101.                   dc.l     link0
  102. link0             set      *-4
  103.                   dc.b     $85!immediate,'leav',$80!'e'
  104.                   cnop     0,2
  105. _leave            dc.l     nest
  106.                   dc.l     _compile,_nest_leave,_exit
  107.  
  108. * ?leave          (s -- ) Compiles the runtime routine (?leave)
  109.                   dc.w     -1
  110.                   dc.l     link3
  111. link3             set      *-4
  112.                   dc.b     $86!immediate,'?leav',$80!'e'
  113.                   cnop     0,2
  114. _question_leave   dc.l     nest
  115.                   dc.l     _compile,_nest_question_leave,_exit
  116.  
  117. ; from here to the end of this file are looping and flow control.
  118.  
  119. * begin
  120. ; Used in: begin..while..repeat  begin..until  begin..again
  121.                   dc.w     -1
  122.                   dc.l     link2
  123. link2             set      *-4
  124.                   dc.b     $85!immediate,'begi',$80!'n'
  125.                   cnop     0,2
  126. _begin            dc.l     nest
  127.                   dc.l     _question_from_mark,_exit
  128.  
  129. * then
  130. ; Used in: if..then if..else..then
  131.                   dc.w     -1
  132.                   dc.l     link0
  133. link0             set      *-4
  134.                   dc.b     $84!immediate,'the',$80!'n'
  135.                   cnop     0,2
  136. _then             dc.l     nest
  137.                   dc.l     _question_to_resolve,_exit
  138.  
  139. * do              (s limit start -- )
  140. ; Used in: do..loop  do..+loop
  141.                   dc.w     -1
  142.                   dc.l     link0
  143. link0             set      *-4
  144.                   dc.b     $82!immediate,'d',$80!'o'
  145.                   cnop     0,2
  146. _do               dc.l     nest
  147.                   dc.l     _compile,_nest_do,_question_to_mark
  148.                   dc.l     _exit
  149.  
  150. * ?do             (s limit start -- )
  151. ; Used in: ?do..loop  ?do..+loop
  152.                   dc.w     -1
  153.                   dc.l     link3
  154. link3             set      *-4
  155.                   dc.b     $83!immediate,'?d',$80!'o'
  156.                   cnop     0,2
  157. _question_do      dc.l     nest
  158.                   dc.l     _compile,_nest_question_do
  159.                   dc.l     _question_to_mark,_exit
  160.  
  161. * loop
  162. ; Used in: do..loop  ?do..loop
  163.                   dc.w     -1
  164.                   dc.l     link0
  165. link0             set      *-4
  166.                   dc.b     $84!immediate,'loo',$80!'p'
  167.                   cnop     0,2
  168. _loop             dc.l     nest
  169.                   dc.l     _compile,_nest_loop,_2dup
  170.                   dc.l     _4_plus,_question_from_resolve
  171.                   dc.l     _question_to_resolve,_exit
  172.  
  173. * +loop           (s n -- )
  174. ; Used in: do..+loop  ?do..+loop
  175.                   dc.w     -1
  176.                   dc.l     link3
  177. link3             set      *-4
  178.                   dc.b     $85!immediate,'+loo',$80!'p'
  179.                   cnop     0,2
  180. _plus_loop        dc.l     nest
  181.                   dc.l     _compile,_nest_plus_loop,_2dup
  182.                   dc.l     _4_plus,_question_from_resolve
  183.                   dc.l     _question_to_resolve,_exit
  184.  
  185. * until           (s f -- )
  186. ; Used in: begin..until
  187.                   dc.w     -1
  188.                   dc.l     link1
  189. link1             set      *-4
  190.                   dc.b     $85!immediate,'unti',$80!'l'
  191.                   cnop     0,2
  192. _until            dc.l     nest
  193.                   dc.l     _compile,_question_branch
  194.                   dc.l     _question_from_resolve,_exit
  195.  
  196. * again
  197. ; Used in: begin..again
  198.                   dc.w     -1
  199.                   dc.l     link1
  200. link1             set      *-4
  201.                   dc.b     $85!immediate,'agai',$80!'n'
  202.                   cnop     0,2
  203. _again            dc.l     nest
  204.                   dc.l     _compile,_branch
  205.                   dc.l     _question_from_resolve,_exit
  206.  
  207. * repeat
  208. ; Used in: begin..while..repeat
  209.                   dc.w     -1
  210.                   dc.l     link2
  211. link2             set      *-4
  212.                   dc.b     $86!immediate,'repea',$80!'t'
  213.                   cnop     0,2
  214. _repeat           dc.l     nest
  215.                   dc.l     _2swap,_again,_then,_exit
  216.  
  217. * if              (s fl -- )
  218. ; Used in: if..else..then
  219.                   dc.w     -1
  220.                   dc.l     link1
  221. link1             set      *-4
  222.                   dc.b     $82!immediate,'i',$80!'f'
  223.                   cnop     0,2
  224. _if               dc.l     nest
  225.                   dc.l     _compile,_question_branch
  226.                   dc.l     _question_to_mark,_exit
  227.  
  228. * else
  229. ; Used in: if..else..then
  230.                   dc.w     -1
  231.                   dc.l     link1
  232. link1             set      *-4
  233.                   dc.b     $84!immediate,'els',$80!'e'
  234.                   cnop     0,2
  235. _else             dc.l     nest
  236.                   dc.l     _compile,_branch
  237.                   dc.l     _question_to_mark,_2swap
  238.                   dc.l     _question_to_resolve,_exit
  239.  
  240. * while           (s fl -- )
  241. ; Used in: begin..while..repeat
  242.                   dc.w     -1
  243.                   dc.l     link3
  244. link3             set      *-4
  245.                   dc.b     $85!immediate,'whil',$80!'e'
  246.                   cnop     0,2
  247. _while            dc.l     nest
  248.                   dc.l     _if,_exit
  249.  
  250.  
  251.